home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 80 / CD Actual 80 Julio-Agosto 2003.iso / Linux / LinuxGazette / lg / issue72 / misc / nielsen / modules / Set_Info.pm < prev   
Encoding:
Perl POD Document  |  2002-08-14  |  7.3 KB  |  241 lines
  1. #!/usr/bin/perl
  2.  
  3. #              Create Functions for Perl/PostgreSQL version 1.0
  4.  
  5. #                       Copyright 2001, Mark Nielsen
  6. #                            All rights reserved.
  7. #    This Copyright notice was copied and modified from the Perl 
  8. #    Copyright notice. 
  9. #    This program is free software; you can redistribute it and/or modify
  10. #    it under the terms of either:
  11.  
  12. #        a) the GNU General Public License as published by the Free
  13. #        Software Foundation; either version 1, or (at your option) any
  14. #        later version, or
  15.  
  16. #        b) the "Artistic License" which comes with this Kit.
  17.  
  18. #    This program is distributed in the hope that it will be useful,
  19. #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either
  21. #    the GNU General Public License or the Artistic License for more details.
  22.  
  23. #    You should have received a copy of the Artistic License with this
  24. #    Kit, in the file named "Artistic".  If not, I'll be glad to provide one.
  25.  
  26. #    You should also have received a copy of the GNU General Public License
  27. #   along with this program in the file named "Copying". If not, write to the 
  28. #   Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 
  29. #    02111-1307, USA or visit their web page on the internet at
  30. #    http://www.gnu.org/copyleft/gpl.html.
  31.  
  32. package SAMPLE::Set_Info;
  33.  
  34. use strict;
  35. use Apache;
  36. use DBI;
  37. use CGI;
  38. use SAMPLE::Misc;
  39. use SAMPLE::Constants;
  40.  
  41. sub new
  42. {
  43. my $Class = shift;
  44. my %Args = @_;
  45. my $self = {};
  46.  
  47. my $Global = SAMPLE::Constants::Get_Constants;
  48.   ### Get the database connection.
  49. $self->{'dbh'} = $Global->{'dbh'};
  50.   ## Load up the queries. 
  51. if (exists $Args{'query'}) {$self->{'query'} = $Args{'query'};}
  52. else {$self->{'query'} = new CGI;}
  53.  
  54. bless $self,$Class;
  55.  
  56. return ($self);
  57. }
  58. #--------------------------------------------------------------------------
  59.  
  60. sub set_general {
  61. my $self = shift;
  62. my %Args = @_;
  63.  
  64. ### You should NEVER use this method manually. 
  65.  
  66.   ## Set the default result to an error number. 
  67. my $Result = -13;
  68.   ## See if we specified a command, error if not. 
  69. my $Command = $Args{'command'};  
  70. my @Commands = ('insert','update','delete','purge','unpurge','purgeone',
  71.   'unpurgeone','undelete','copy','change');
  72. if (!(grep($_ eq $Command, @Commands))) {return (-11);}
  73.   ## See if we specified an Id, if not error out.
  74. my $Id = $Args{'id'};
  75. if (($Id < 1) && !(grep($_ ne $Command,('insert','purge','unpurge'))))
  76.    {return (-10);}
  77.  
  78. my $TableName = $Args{'tablename'};
  79. my $Columns = $Args{'columns'};
  80.   ### If we somehow didn't get the tablename or columns, return error. 
  81.   ### This should be impossible since they are supplies by other
  82.   ### functions.  
  83. if (($TableName eq "") || ((@$Columns) < 1)) {return (-14);}
  84.  
  85. if (grep($_ eq $Command,('delete','undelete','purgeone','unpurgeone','copy'))) 
  86.   {
  87.   my $Sql = "select sql_$TableName\_$Command\(?) as $Command";
  88.   my $sth = $self->{'dbh'}->prepare($Sql);
  89.   $sth->execute($Id);
  90.   my $ref = $sth->fetchrow_hashref();
  91.   $Result = $ref->{$Command};
  92.   }
  93. elsif (grep($_ eq $Command, ('insert','purge','unpurge')))
  94.   {
  95.   my $Sql = "select sql_$TableName\_$Command\() as $Command";
  96.   my $sth = $self->{'dbh'}->prepare($Sql);
  97.   $sth->execute();
  98.   my $ref = $sth->fetchrow_hashref();
  99.   $Result = $ref->{$Command};
  100.   }
  101.   ### Use the update function to explicity define every field. 
  102.   ### Use the change function when you want to specify only certain
  103.   ### fields. 
  104. elsif ($Command eq "update")
  105.   {
  106.   my $query = $self->{'query'};
  107.   if (exists $Args{'query'}) {$query = $Args{'query'};}
  108.     ### If we were supplied a query, use it instead. 
  109.   if (exists $Args{'query'}) {$query = $Args{'query'};}
  110.   my @Fields = @$Columns;
  111.   my @Values = ();
  112.   my $String = "";
  113.  
  114.   my $args = \%Args;
  115.   foreach my $Field (@Fields) 
  116.     {
  117.     my $Value = '';
  118.     ## If we supplied a list of fields, use them.
  119.     if (exists $args->{'fields'}->{$Field})
  120.       { $Value = $args->{'fields'}->{$Field};}
  121.     else {$Value = $query->param($Field) || '';}  
  122.     if ($Value eq "") {$Value = '';}
  123.     $Value = GES::Misc->Clean_String($Value);
  124.     push (@Values,$Value);
  125.     $String .= ",?";
  126.     }
  127.  
  128.   my $Sql = "select sql_$TableName\_update(? $String) as update";
  129.   my $sth = $self->{'dbh'}->prepare($Sql);
  130.   $sth->execute($Id,@Values);
  131.   my $ref = $sth->fetchrow_hashref();
  132.   $Result = $ref->{'update'};
  133.   }
  134.   ### This function is used when you only want to change the values and
  135.   ### fields you specify. It will work with no fields specified, which is
  136.   ### just a copy in the backup table. 
  137. elsif ($Command eq "change")
  138.   {
  139.   my $query = $self->{'query'};
  140.   if (exists $Args{'query'}) {$query = $Args{'query'};}
  141.     ### If we were supplied a query, use it instead. 
  142.   if (exists $Args{'query'}) {$query = $Args{'query'};}
  143.   my @Fields = @$Columns;
  144.   my @Values = ();
  145.   my $String = "";
  146.   my @Params = $query->param();
  147.  
  148.   my $Sql = "select *  from $TableName where $TableName\_id = ?";
  149.   my $sth = $self->{'dbh'}->prepare($Sql);
  150.   $sth->execute($Id);
  151.   my $No = $sth->rows();
  152.     ## If we don't have one thing to change, return an error. 
  153.   if ($No < 1) {return (-100);}
  154.   my $Previous = $sth->fetchrow_hashref();
  155.  
  156.   my $args = \%Args;
  157.   foreach my $Field (@Fields) 
  158.     {
  159.     my $Value = '';
  160.     ## If we supplied a list of fields, use them.
  161.     if (exists $args->{'fields'}->{$Field})
  162.       { $Value = $args->{'fields'}->{$Field};}
  163.     elsif (grep($_ eq $Field, @Params)) 
  164.       { $Value = $query->param($Field); }
  165.     else {$Value = $Previous->{$Field};}  
  166.     if ($Value eq "") {$Value = '';}
  167.     
  168.     $Value = GES::Misc->Clean_String($Value);
  169.     push (@Values,$Value);
  170.     $String .= ",?";
  171.     }
  172.  
  173.   my $Sql = "select sql_$TableName\_update(? $String) as update";
  174.   my $sth = $self->{'dbh'}->prepare($Sql);
  175.   $sth->execute($Id,@Values);
  176.   my $ref = $sth->fetchrow_hashref();
  177.   $Result = $ref->{'update'};
  178.   }
  179.  
  180. return ($Result);
  181. }
  182.  
  183. ### Remember to create a "new" function which defines 
  184. ### $query and also $dbh in $self. 
  185. ### Also, remember to have "use CGI;" in the perl module. 
  186.  
  187. sub Set_class {
  188. my $self = shift;
  189. my %Args = @_;
  190.  
  191. $Args{'tablename'} = "class";
  192. $Args{'columns'} = ['time','title','description','users_id'];
  193. my $Result = $self->set_general(%Args);
  194.  
  195. return ($Result);
  196. }
  197. ### Remember to create a "new" function which defines 
  198. ### $query and also $dbh in $self. 
  199. ### Also, remember to have "use CGI;" in the perl module. 
  200.  
  201. sub Set_contact {
  202. my $self = shift;
  203. my %Args = @_;
  204.  
  205. $Args{'tablename'} = "contact";
  206. $Args{'columns'} = ['company_name','first','middle','last','email','work_phone','home_phone','address_1','address_2','address_3','city','state','zip','country'];
  207. my $Result = $self->set_general(%Args);
  208.  
  209. return ($Result);
  210. }
  211. ### Remember to create a "new" function which defines 
  212. ### $query and also $dbh in $self. 
  213. ### Also, remember to have "use CGI;" in the perl module. 
  214.  
  215. sub Set_students {
  216. my $self = shift;
  217. my %Args = @_;
  218.  
  219. $Args{'tablename'} = "students";
  220. $Args{'columns'} = ['users_id','class_id'];
  221. my $Result = $self->set_general(%Args);
  222.  
  223. return ($Result);
  224. }
  225. ### Remember to create a "new" function which defines 
  226. ### $query and also $dbh in $self. 
  227. ### Also, remember to have "use CGI;" in the perl module. 
  228.  
  229. sub Set_users {
  230. my $self = shift;
  231. my %Args = @_;
  232.  
  233. $Args{'tablename'} = "users";
  234. $Args{'columns'} = ['username','password','user_type','contact_id'];
  235. my $Result = $self->set_general(%Args);
  236.  
  237. return ($Result);
  238. }
  239.  
  240. 1;
  241.